home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 363 / xprolog2 / _boot next >
Text File  |  1985-11-19  |  6KB  |  221 lines
  1. /*
  2.  *        X PROLOG  Vers. 2.0
  3.  *
  4.  *
  5.  *    Written by :     Andreas Toenne
  6.  *            CS Dept. , IRB
  7.  *            University of Dortmund, W-Germany
  8.  *            <atoenne@unido.uucp>
  9.  *            <....!seismo!unido!atoenne>
  10.  *            <atoenne@unido.bitnet>
  11.  *
  12.  *    Copyright :    This software is copyrighted by Andreas Toenne.
  13.  *            Permission is granted hereby to copy the entire
  14.  *            package including this copyright notice without fee.
  15.  *
  16.  */
  17.  
  18. %    X Prolog Boot File
  19.  
  20. % hack to create an intermediate goal for call
  21. % this make the cut local to call
  22.  
  23. call(A) :- $call(A).
  24.  
  25. % definitions for conjunction and disjunction
  26. % both procedures are made transparent to the cut
  27.  
  28. (A ; B) :- $call(A).
  29. (A ; B) :- $call(B).
  30.  
  31. (A , B) :- $call(A), $call(B).
  32.  
  33. % further predicates
  34.  
  35. not(Predicate) :- call(Predicate), !, fail.
  36. not(Predicate).
  37.  
  38. clause(Head, Body) :- $clause(Head, Body, Help).  % see the documentation
  39.  
  40. A = A.                    % equality predicate :-)
  41.  
  42. print(Term) :- var(Term), !, write(Term).
  43. print(Term) :- portray(Term).        % portray should be user defined
  44.  
  45. append([],L,L).                % common append procedure
  46. append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).
  47.  
  48. member(X, [X|_]).            % common member procedure
  49. member(X, [_|Y]) :- member(X, Y).
  50.  
  51. % toplevel interpreter loop
  52. % the main goal should not be changed
  53.  
  54. main :- $loop(toplevel).        % start things
  55. main.                    % just to make Xprolog happy
  56.  
  57. % this is a failure driven loop
  58.  
  59. $loop(toplevel) :-
  60.     prompt(Old, '|    '),        % change the default prompt
  61.     repeat,                % loop forever
  62.         $prompt('?- '),        % give a prompt
  63.         read(Term),        % wait for response
  64.         $solve(Term, toplevel),    % solve the query
  65.     prompt(_, Old),            % restore the prompt
  66.     !.
  67. $loop(Where) :-                % loop not at top level
  68.     prompt(Old, '| '),        % different default prompt
  69.     repeat,                % round and round again
  70.         prompt_if_user,        % no prompt for files
  71.         read(Term),        % read something
  72.         $solve(Term, Where),    % solve it
  73.     prompt(_, Old),            % restore the prompt
  74.     !.
  75.     
  76. prompt_if_user :- seeing(user), $prompt('| '), !.
  77. prompt_if_user.
  78.  
  79. $solve(end_of_file, _) :- !.        % the only way to stop the repeat
  80. $solve(Term, _) :- var(Term), !, fail.    % don't accept strange goals
  81. $solve(Term, Where) :-            % try to solve it as a goal
  82.     $query(Term, Where, Goal, What), % check for sort of question
  83.     !,
  84.     prompt(Old, '|: '),
  85.     $solve_goal(Goal, What),    % try to solve a goal
  86.     prompt(_, Old),
  87.     fail.
  88. $solve(Term, Where) :-            % try to assert it
  89.     $process(Term, Result),        % hook for preprocessors
  90.     assertz(Result),        % assert it
  91.     !,
  92.     fail.
  93. $solve(Term, _) :-            % assert or $process failed
  94.     write('! clause: '),
  95.     write(Term),
  96.     fail.
  97.     
  98. % this is a hook to add preprocessors like the grammar rule translator
  99. % to this top level interpreter.
  100. % simply add via 'asserta' another clause for the preprocessor
  101.  
  102. $process(T,T).
  103.  
  104. % check the current term for a question or a command
  105.  
  106. $query(:-(X), _, X, command) :- !.    % this is a command
  107. $query(?-(X), _, X, question) :- !.    % this is a question
  108. $query(X, toplevel, X, question).    % always questions on top level
  109.  
  110. % this procedure solves goals
  111. % note the use of $more and $goalvars
  112.  
  113. $solve_goal(Term, command) :-        % no answer, no alternatives
  114.     call(Term),            % try it once
  115.     !.                % and no further alternatives
  116. $solve_goal(_, command)    :-        % above clause failed
  117.     !,
  118.     nl, write('?'), nl.        % notify the user
  119. $solve_goal(Term, question) :-
  120.     $goalvars(List),        % save the reader's symbol table
  121.     call(Term),            % try the question
  122.     $more(Ok),            % call(Term) had a alternative ?
  123.     $reply(List, Ok),        % say 'yes' to the user
  124.     nl,
  125.     !.
  126. $solve_goal(_, question) :-        % above clause failed !
  127.     nl,
  128.     write(no),            % sorry but ...
  129.     nl,
  130.     !.
  131.     
  132. $reply(List, Ok) :-            % say yes and show variables
  133.     $show_variables(List),
  134.     write(yes),            % horray
  135.     Ok = yes,            % an alternative ?
  136.     $askformore,            % check if the user wants it
  137.     !.
  138. $reply(_, Ok) :-            % no more alternative
  139.     Ok = no,
  140.     !.
  141.     
  142. $askformore :- get(X), skip(10), X \== 59. % 59 is ';'
  143.     
  144. $show_variables([]) :- !.
  145. $show_variables([(Name, Variable)|L]) :-
  146.     write(Name),
  147.     write(' = '),
  148.     write(Variable),
  149.     nl,
  150.     !,
  151.     $show_variables(L).
  152.     
  153.  
  154.  
  155. % consult and friends
  156. % we simply use the top level interpreter for the asserts and queries
  157.  
  158. [X|Y] :- $process_files([X|Y]).
  159.  
  160. $process_files([]) :- !.
  161. $process_files([-File|Rest]) :- !, reconsult(File), $process_files(Rest).
  162. $process_files([File|Rest]) :- !, consult(File), $process_files(Rest).
  163.  
  164. consult(File) :- !, $read_file(File, 0).
  165.  
  166. reconsult(File) :- !, $read_file(File, 1).
  167.  
  168. $read_file(File, R) :-
  169.     Heap is heapused,
  170.     Time is cputime,
  171.     $reconsulting(R),
  172.     $test_filename(File),        % check the file
  173.     seeing(OldIn),
  174.     telling(OldOut),
  175.     see(File),            % open the file
  176.     $do_loop,
  177.     seen,                % close the file
  178.     see(OldIn),
  179.     tell(OldOut),
  180.     $reconsulting(0),
  181.     DiffTime is cputime - Time,
  182.     DiffHeap is heapused - Heap,
  183.     write(File),
  184.     ( R == 0 , write('  consulted ') ;
  185.       R == 1 , write('  reconsulted ')),
  186.     write(DiffHeap), write(' bytes '),
  187.     write(DiffTime), write(' msec.'),
  188.     nl, !.
  189.  
  190. $do_loop :- $loop(filelevel).        % loop at filelevel
  191. $do_loop.
  192.  
  193. $test_filename(user) :- !.        % this stream is always ok
  194. $test_filename(File) :-
  195.     not atom(File),            % invalid name
  196.     nl,
  197.     write('Invalid filename: '),
  198.     write(File),
  199.     nl,
  200.     !, fail.
  201. $test_filename(File) :-
  202.     not exists(File),        % file not found
  203.     nl,
  204.     write('The file '),
  205.     write(File),
  206.     write(' does not exist.'),
  207.     nl,
  208.     !, fail.
  209. $test_filename(_).            % is ok
  210.  
  211. %
  212. % debugging hooks
  213. %
  214.  
  215. leash(off) :- $leash(0).
  216. leash(loose) :- $leash(1).
  217. leash(half) :- $leash(5).
  218. leash(tight) :- $leash(7).
  219. leash(full) :- $leash(15).
  220.  
  221.